home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / os2 / e33el2.zip / emacs / 19.33 / lisp / trace.el < prev    next >
Lisp/Scheme  |  1996-01-20  |  11KB  |  315 lines
  1. ;;; trace.el --- tracing facility for Emacs Lisp functions
  2.  
  3. ;; Copyright (C) 1993 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
  6. ;; Created: 15 Dec 1992
  7. ;; Keywords: tools, lisp
  8.  
  9. ;; This file is part of GNU Emacs.
  10.  
  11. ;; GNU Emacs is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; GNU Emacs is distributed in the hope that it will be useful,
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. ;; GNU General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24. ;; Boston, MA 02111-1307, USA.
  25.  
  26. ;; LCD Archive Entry:
  27. ;; trace|Hans Chalupsky|hans@cs.buffalo.edu|
  28. ;; Tracing facility for Emacs Lisp functions|
  29. ;; 1993/05/18 00:41:16|2.0|~/packages/trace.el.Z|
  30.  
  31.  
  32. ;;; Commentary:
  33.  
  34. ;; Introduction:
  35. ;; =============
  36. ;; A simple trace package that utilizes advice.el. It generates trace 
  37. ;; information in a Lisp-style fashion and inserts it into a trace output
  38. ;; buffer. Tracing can be done in the background (or silently) so that
  39. ;; generation of trace output won't interfere with what you are currently
  40. ;; doing.
  41.  
  42. ;; How to get the latest trace.el:
  43. ;; ===============================
  44. ;; You can get the latest version of this file either via anonymous ftp from 
  45. ;; ftp.cs.buffalo.edu (128.205.32.9) with pathname /pub/Emacs/trace.el,
  46. ;; or send email to hans@cs.buffalo.edu and I'll mail it to you.
  47.  
  48. ;; Requirement:
  49. ;; ============
  50. ;; trace.el needs advice.el version 2.0 or later which you can get from the
  51. ;; same place from where you got trace.el.
  52.  
  53. ;; Restrictions:
  54. ;; =============
  55. ;; - Traced subrs when called interactively will always show nil as the
  56. ;;   value of their arguments.
  57. ;; - Only functions/macros/subrs that are called via their function cell will
  58. ;;   generate trace output, hence, you won't get trace output for:
  59. ;;   + Subrs called directly from other subrs/C-code
  60. ;;   + Compiled calls to subrs that have special byte-codes associated
  61. ;;     with them (e.g., car, cdr, ...)
  62. ;;   + Macros that were expanded during compilation
  63. ;; - All the restrictions that apply to advice.el
  64.  
  65. ;; Installation:
  66. ;; =============
  67. ;; Put this file together with advice.el (version 2.0 or later) somewhere
  68. ;; into your Emacs `load-path', byte-compile it/them for efficiency, and
  69. ;; put the following autoload declarations into your .emacs
  70. ;;
  71. ;;    (autoload 'trace-function "trace" "Trace a function" t)
  72. ;;    (autoload 'trace-function-background "trace" "Trace a function" t)
  73. ;;
  74. ;; or explicitly load it with (require 'trace) or (load "trace").
  75.  
  76. ;; Comments, suggestions, bug reports
  77. ;; ==================================
  78. ;; are strongly appreciated, please email them to hans@cs.buffalo.edu.
  79.  
  80. ;; Usage:
  81. ;; ======
  82. ;; - To trace a function say `M-x trace-function' which will ask you for the
  83. ;;   name of the function/subr/macro to trace, as well as for the buffer
  84. ;;   into which trace output should go.
  85. ;; - If you want to trace a function that switches buffers or does other
  86. ;;   display oriented stuff use `M-x trace-function-background' which will
  87. ;;   generate the trace output silently in the background without popping
  88. ;;   up windows and doing other irritating stuff.
  89. ;; - To untrace a function say `M-x untrace-function'.
  90. ;; - To untrace all currently traced functions say `M-x untrace-all'.
  91.  
  92. ;; Examples:
  93. ;; =========
  94. ;;
  95. ;;  (defun fact (n)
  96. ;;    (if (= n 0) 1
  97. ;;      (* n (fact (1- n)))))
  98. ;;  fact
  99. ;;  
  100. ;;  (trace-function 'fact)
  101. ;;  fact
  102. ;;
  103. ;;  Now, evaluating this...
  104. ;;
  105. ;;  (fact 4)
  106. ;;  24
  107. ;;
  108. ;;  ...will generate the following in *trace-buffer*:
  109. ;;
  110. ;;  1 -> fact: n=4
  111. ;;  | 2 -> fact: n=3
  112. ;;  | | 3 -> fact: n=2
  113. ;;  | | | 4 -> fact: n=1
  114. ;;  | | | | 5 -> fact: n=0
  115. ;;  | | | | 5 <- fact: 1
  116. ;;  | | | 4 <- fact: 1
  117. ;;  | | 3 <- fact: 2
  118. ;;  | 2 <- fact: 6
  119. ;;  1 <- fact: 24
  120. ;;
  121. ;;
  122. ;;  (defun ack (x y z)
  123. ;;    (if (= x 0) 
  124. ;;        (+ y z)
  125. ;;      (if (and (<= x 2) (= z 0)) 
  126. ;;          (1- x)
  127. ;;        (if (and (> x 2) (= z 0)) 
  128. ;;            y
  129. ;;          (ack (1- x) y (ack x y (1- z)))))))
  130. ;;  ack
  131. ;;
  132. ;;  (trace-function 'ack)
  133. ;;  ack
  134. ;;
  135. ;;  Try this for some interesting trace output:
  136. ;;
  137. ;;  (ack 3 3 1)
  138. ;;  27
  139. ;;
  140. ;; 
  141. ;; The following does something similar to the functionality of the package
  142. ;; log-message.el by Robert Potter, which is giving you a chance to look at
  143. ;; messages that might have whizzed by too quickly (you won't see subr
  144. ;; generated messages though):
  145. ;;
  146. ;; (trace-function-background 'message "*Message Log*")
  147.  
  148.  
  149. ;;; Change Log:
  150.  
  151. ;; Revision 2.0 1993/05/18 00:41:16 hans
  152. ;;    * Adapted for advice.el 2.0; it now also works
  153. ;;      for GNU Emacs-19 and Lemacs
  154. ;;    * Separate function `trace-function-background'
  155. ;;    * Separate pieces of advice for foreground and background tracing
  156. ;;    * Less insane handling of interactive trace buffer specification
  157. ;;    * String arguments and values are now printed properly
  158. ;;
  159. ;; Revision 1.1 1992/12/15 22:45:15 hans
  160. ;;    * Created, first public release
  161.  
  162.  
  163. ;;; Code:
  164.  
  165. (require 'advice)
  166.  
  167. ;;;###autoload
  168. (defvar trace-buffer "*trace-output*"
  169.   "*Trace output will by default go to that buffer.")
  170.  
  171. ;; Current level of traced function invocation:
  172. (defvar trace-level 0)
  173.  
  174. ;; Semi-cryptic name used for a piece of trace advice:
  175. (defvar trace-advice-name 'trace-function\ )
  176.  
  177. ;; Used to separate new trace output from previous traced runs:
  178. (defvar trace-separator (format "%s\n" (make-string 70 ?=)))
  179.  
  180. (defun trace-entry-message (function level argument-bindings)
  181.   ;; Generates a string that describes that FUNCTION has been entered at
  182.   ;; trace LEVEL with ARGUMENT-BINDINGS.
  183.   (format "%s%s%d -> %s: %s\n"
  184.       (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
  185.       (if (> level 1) " " "")
  186.       level
  187.       function
  188.       (mapconcat (function
  189.               (lambda (binding)
  190.             (concat
  191.              (symbol-name (ad-arg-binding-field binding 'name))
  192.              "="
  193.              ;; do this so we'll see strings:
  194.              (prin1-to-string
  195.               (ad-arg-binding-field binding 'value)))))
  196.              argument-bindings
  197.              " ")))
  198.  
  199. (defun trace-exit-message (function level value)
  200.   ;; Generates a string that describes that FUNCTION has been exited at
  201.   ;; trace LEVEL and that it returned VALUE.
  202.   (format "%s%s%d <- %s: %s\n"
  203.       (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
  204.       (if (> level 1) " " "")
  205.       level
  206.       function
  207.       ;; do this so we'll see strings:
  208.       (prin1-to-string value)))
  209.  
  210. (defun trace-make-advice (function buffer background)
  211.   ;; Builds the piece of advice to be added to FUNCTION's advice info
  212.   ;; so that it will generate the proper trace output in BUFFER
  213.   ;; (quietly if BACKGROUND is t).
  214.   (ad-make-advice
  215.    trace-advice-name nil t
  216.    (cond (background
  217.       (` (advice
  218.           lambda ()
  219.           (let ((trace-level (1+ trace-level))
  220.             (trace-buffer (get-buffer-create (, buffer))))
  221.         (save-excursion
  222.           (set-buffer trace-buffer)
  223.           (goto-char (point-max))
  224.           ;; Insert a separator from previous trace output:
  225.           (if (= trace-level 1) (insert trace-separator))
  226.           (insert
  227.            (trace-entry-message
  228.             '(, function) trace-level ad-arg-bindings)))
  229.         ad-do-it
  230.         (save-excursion
  231.           (set-buffer trace-buffer)
  232.           (goto-char (point-max))
  233.           (insert
  234.            (trace-exit-message
  235.             '(, function) trace-level ad-return-value)))))))
  236.      (t (` (advice
  237.         lambda ()
  238.         (let ((trace-level (1+ trace-level))
  239.               (trace-buffer (get-buffer-create (, buffer))))
  240.           (pop-to-buffer trace-buffer)
  241.           (goto-char (point-max))
  242.           ;; Insert a separator from previous trace output:
  243.           (if (= trace-level 1) (insert trace-separator))
  244.           (insert
  245.            (trace-entry-message
  246.             '(, function) trace-level ad-arg-bindings))
  247.           ad-do-it
  248.